home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_5771.txt < prev    next >
Text File  |  1990-04-17  |  4KB  |  175 lines
  1. -- card: 5771 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: HyperFolder
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XFCN,HyperFolder,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (button)
  14. -- low flags: 00
  15. -- high flags: A003
  16. -- rect: left=80 top=300 right=322 bottom=180
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 1
  20. -- font id: 0
  21. -- text size: 12
  22. -- style flags: 0
  23. -- line height: 16
  24. -- part name: HyperFolder
  25. ----- HyperTalk script -----
  26. on mouseUp
  27.   answer HyperFolder()
  28. end mouseUp
  29.  
  30.  
  31.  
  32. -- part 2 (button)
  33. -- low flags: 00
  34. -- high flags: A003
  35. -- rect: left=299 top=300 right=322 bottom=438
  36. -- title width / last selected line: 0
  37. -- icon id / first selected line: 0 / 0
  38. -- text alignment: 1
  39. -- font id: 0
  40. -- text size: 12
  41. -- style flags: 0
  42. -- line height: 16
  43. -- part name: Show Pascal Source
  44. ----- HyperTalk script -----
  45. on mouseUp
  46.   set the visible of card field 1 to not the visible of card field 1
  47.   if the visible of card field 1 is true then
  48.     set the name of me to "Hide Pascal Source"
  49.   else set the name of me to "Show Pascal Source"
  50. end mouseUp
  51.  
  52.  
  53.  
  54. -- part 3 (field)
  55. -- low flags: 81
  56. -- high flags: 2007
  57. -- rect: left=12 top=26 right=298 bottom=491
  58. -- title width / last selected line: 0
  59. -- icon id / first selected line: 0 / 0
  60. -- text alignment: 0
  61. -- font id: 22
  62. -- text size: 10
  63. -- style flags: 0
  64. -- line height: 13
  65. -- part name: Source
  66.  
  67.  
  68. -- part contents for background part 16
  69. ----- text -----
  70. HYPERFOLDER XFCN version 1.0.1
  71. Kevin Calhoun
  72.  
  73. HyperFolder returns the pathname of the folder that contains the copy of HyperCard that's currently running, appended by a colon.  I'm not sure what it's good for, but I thought I'd throw it in here anyway, just to keep the SystemFolder XFCN company.
  74.  
  75. 22 July 1989 -- Declares the directory ID as a longint in the parameter list of DirIDToPath.
  76.  
  77. -- part contents for card part 3
  78. ----- text -----
  79. UNIT HooperFolder;
  80.  
  81. { HyperFolder XFCN ┬⌐1989 by the Trustees of Dartmouth College }
  82. { Written by Kevin Calhoun }
  83.  
  84. { This source compatible with MPW Pascal 3.0 }
  85.  
  86. (*
  87. pascal HyperFolder.p
  88. Link -m ENTRYPOINT Γêé
  89.      -o "YourFile" Γêé
  90.      -rt XFCN=970 Γêé
  91.      -sn Main=HyperFolder Γêé
  92.      HyperFolder.p.o Γêé
  93.     "{Libraries}"interface.o Γêé
  94.     "{PLibraries}"PasLib.o Γêé
  95.     "{Libraries}"HyperXLib.o
  96. *)
  97.  
  98. {$R-}
  99.  
  100. INTERFACE
  101.   USES
  102.     Types,
  103.     Memory,
  104.     Files,
  105.     Packages,
  106.     HyperXCmd;
  107.  
  108.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  109.  
  110. IMPLEMENTATION
  111.  
  112.   PROCEDURE HyperFolder (paramPtr : XCMDPtr); FORWARD;
  113.  
  114.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  115.   BEGIN
  116.     HyperFolder(paramPtr);
  117.   END;
  118.   
  119.   PROCEDURE DirIDToPath(paramPtr: XCMDPtr; dirID: LONGINT; 
  120.                       vRefNum: INTEGER; VAR path: Str255);
  121.   VAR result:  INTEGER;
  122.       str:  Str255;
  123.       pb:   CInfoPBRec;
  124.   BEGIN
  125.     path := '';
  126.     ZeroBytes(paramPtr,@pb,SizeOf(pb));
  127.     pb.ioDirID := dirID;
  128.     WHILE pb.ioDirID <> 1 DO 
  129.       BEGIN
  130.       pb.ioNamePtr := @str;
  131.       pb.ioFDirIndex := -1;
  132.       pb.ioVRefNum := vRefNum;
  133.       IF PBGetCatInfo(@pb,FALSE) <> noErr THEN Exit(DirIDToPath);
  134.       path := Concat(str,':',path);
  135.       pb.ioDirID := pb.ioDrParID;
  136.       END;
  137.   END;
  138.   
  139.   FUNCTION CurApRefNum: INTEGER;
  140.     CONST
  141.       appRefNum = $900;
  142.     TYPE
  143.       WordPtr = ^INTEGER;
  144.     VAR
  145.       myWord: WordPtr;
  146.   BEGIN
  147.     myWord := WordPtr(appRefNum);
  148.     CurApRefNum := myWord^;
  149.   END;
  150.  
  151.   PROCEDURE HyperFolder(paramPtr: XCMDPtr);
  152.     VAR
  153.       err: OSErr;
  154.       myFCBPBRec: FCBPBRec;
  155.       s: Str255;
  156.   BEGIN
  157.     ZeroBytes(paramPtr, @myFCBPBRec, SIZEOF(FCBPBRec));
  158.     with myFCBPBRec DO
  159.       BEGIN
  160.       ioCompletion := NIL;
  161.       ioNamePtr := NIL;
  162.       ioRefNum := CurApRefNum;
  163.       ioFCBIndx := 0;
  164.       END;
  165.     err := PBGetFCBInfo(@myFCBPBRec, FALSE);
  166.     IF err = noErr THEN DirIDToPath(paramPtr, myFCBPBRec.ioFCBParID, myFCBPBRec.ioFCBVRefNum, s);
  167.     IF err <> noErr THEN
  168.       BEGIN
  169.       NumToStr(paramPtr, err, s);
  170.       s := CONCAT('Error ', s);
  171.       END;
  172.     paramPtr^.returnValue := PasToZero(paramPtr, s);
  173.   END;
  174.  
  175. END.